perm filename JUST.F4[NEW,LCS]3 blob
sn#271110 filedate 1977-03-22 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 C TO JUSTIFY SEVERAL MSS FILES AT ONCE. (UP TO 15.)(8*15=120)
C00018 ENDMK
C⊗;
C TO JUSTIFY SEVERAL MSS FILES AT ONCE. (UP TO 15.)(8*15=120)
C TO CONVERT(ONE FILE AT A TIME)TO NEW FORMAT, USE 'CONVT' AS 'LAST NAME'.
C LOAD WITH -- BIGGET.FAI ---
COMMON/XRN/ RN(20000)/PTR/KWDS(2500) ,RSTFAC(120),STFF(120)
1 /RINP/RINP(8),K,SST(8),J,IB,RRT,A,Z,JJ,MX,H(8)
1 /RJV/V(200) /RR4/R4,R5,P1,P2,IH,M
C M=NUM OF STAVES. (BY 8S)
COMMON JK,L,R8,R9,RDIS /NNP/NP(1500) /MMV/MV(1500) /KJY/KY,LY
C INCREASE NP AND MV IF NEEDED -- PUT TRAP IN BIGGET!
DATA EXT/'DMD'/,OUTX/'DMD'/
DIMENSION JW(120),JR(120)
TYPE 1
1 FORMAT(' FILE NAME 1? '$)
CC ACCEPT 200,N1
CALL NAMEIN(N1,EXT)
200 FORMAT(A5)
TYPE 300
300 FORMAT(' LAST NAME? '$)
ACCEPT 200,N2
TYPE 3011
3011 FORMAT(' TYPE OUTPUT NAME 1 -- '$)
CC ACCEPT 200,NMX
CALL NAMEIN(NMX,OUTX)
IF(N2.EQ.'CONVT')GO TO 111
TYPE 100
100 FORMAT(' POS.1, POS.2 - '$)
ACCEPT 111,P1,P2
IF(P2.EQ.0)P2=200
111 FORMAT(2F)
IF(NMX.EQ.' ')NMX='AAAAA'
JW(1)=1
JR(1)=1
M=1
L=0
JX=1
IX=1
NX=1
NM=N1
40 CALL GETEXT(NM,EXT)
CALL EXTIN(RINP,32)
CALL EXTIN(KWDS(JX),J)
CALL EXTIN(RN(IX),IB)
J=J-2
JJ=0
DO 1111 K=NX,NX+7
JJ=JJ+1
RSTFAC(K)=RINP(JJ)
1111 STFF(K)=SST(JJ)
IF(N2.EQ.'CONVT')GO TO 2
C ********* TYPE 999 AS POS1. FOR 'CONVERT', NAME2 WILL BE OUTPUT NM.
RX=NX-1
IF(RX.EQ.0)GO TO 410
DO 41 K=JX,JX+J
KWDS(K)=KWDS(K)+L
KX=KWDS(K)+2
C +2 IS FOR STAFF #
41 RN(KX)=RN(KX)+RX
410 IX=IB+IX-1
L=IX-1
JX=J+JX
JW(M+1)=JX
C POINTER TO START OF KWDS FOR EACH FILE
JR(M+1)=IX
NX=NX+8
IF(IX.LT.19500)GO TO 400
RRT=IX
TYPE 111,RRT
400 IF(NM.EQ.N2)GO TO 5
NM=NM+2
M=M+1
GO TO 40
2 JJ=1
3001 L=KWDS(JJ)
K=L+1
A=RN(K)
Z=RN(L)
IF(A.LT.5)GO TO 3002
IF(A.LE.10)GO TO 1177
IF(A.NE.20)GO TO 3002
1177 IF(A.NE.6)GO TO 3003
RN(K)=9
GO TO 3002
3003 IF(A.NE.5)GO TO 3004
RN(K)=10
IF(Z.LT.4)GO TO 3010
CALL EXCH(RN(L+5),RN(L+6))
GO TO 3002
3004 IF(A.NE.7)GO TO 3005
RN(K)=17
GO TO 3010
3005 IF(A.EQ.8)RN(K)=5
IF(A.EQ.9)RN(K)=6
IF(A.NE.10)GO TO 3006
RN(K)=8
IF(Z.LT.4)GO TO 3010
CALL EXCH(RN(L+4),RN(L+5))
CALL EXCH(RN(L+6),RN(L+5))
GO TO 3002
3006 IF(A.EQ.20)RN(K)=7
IF(A.NE.18)GO TO 3002
3010 FORMAT(' ITEM ',I3,', CODE ',F3.0)
TYPE 3010,JJ,A
3002 A=RN(L+2)
RN(L+2)=RN(L+3)
RN(L+3)=A
A=L+Z+3
JJ=JJ+1
IF(A.EQ.KWDS(JJ))GO TO 3001
MX=1
CC IF(N2.NE.' ')NM=N2
GO TO 6
5 IB=JX-1
C TOTAL IN RN ('I' IN MXX.F4)
CALL JJUST
C START OF WRITER
6 NM=NMX
JX=1
IX=1
NX=1
L=0
ISCR=1
Z=0
MX=M
M=1
7 CALL PUTEXT(NM,OUTX)
JJ=0
DO 7000 K=NX,NX+7
JJ=JJ+1
RINP(JJ)=RSTFAC(K)
7000 SST(JJ)=STFF(K)
IF(N2.EQ.'CONVT')GO TO 3
J=JW(M+1)-JW(M)
IB=JR(M+1)-JR(M)+1
P1=KWDS(JX+J)
RX=NX-1
IF(RX.EQ.0)GO TO 3
DO 61 K=JX,JX+J-1
KX=KWDS(K)
KWDS(K)=KX-L
KX=KX+2
61 RN(KX)=RN(KX)-RX
KWDS(JX+J)=KWDS(JX+J)-L
3 L=IB+IX-2
J=J+2
CALL EXTOUT(RINP,32)
CALL EXTOUT(KWDS(JX),J)
CALL EXTOUT(RN(IX),IB)
J=J-2
KWDS(JX+J)=P1
TYPE 60,NM
IF(M.EQ.MX)CALL EXIT
M=M+1
JX=JW(M)
IX=JR(M)
NX=NX+8
CC END FILE 21
NM=NM+2
GO TO 7
60 FORMAT(1XA5)
END
SUBROUTINE JJUST
DATA RSP/.5/,RI/4.5/,RPX/.2/
COMMON/XRN/ RN(20000)/PTR/KWDS(2500) ,RSTFAC(120),STFF(120)
1 /RINP/RINP(8),K,SST(8),J,IB,RRT,A,Z,JJ,MX,H(8)
1 /RJV/R(2,100) /RR4/R4,R5,P1,P2,IH,M
C M=NUM OF STAVES. (BY 8S)
COMMON JK,L,R8,R9,RDIS /NNP/NP(1000) /MMV/MV(1000) /KJY/KY,LY
C INCREASE NP AND MV IF NEEDED
DIMENSION IR(2,100)
EQUIVALENCE (R,IR)
IX=KWDS(IB+1)-1
PRCNT=1.
RRT=P2
R5=P2
RZRO=P1
R4=P1
IF(RRT.EQ.0)RRT=200
IF(RZRO.EQ.0)RZRO=.001
JCNT=0
RJSZ=RI
CALL BIGGET
C BIG GETPTS FAIL ROUTINE
ML=1
ROV=RRT
19 IF(JCNT.GT.9)GO TO 101
RP=PRCNT
RJSZ=RJSZ-RPX
JCNT=JCNT+1
C TEMPORARY COUNTER
TYPE 111,JCNT
111 FORMAT(I4)
C%%%%% DO 11 KN=-3,M*8-4
DO 11 KN=0,M*8-1
RSPC=0
R8=KN
N=0
DO 2 K=1,KY
L=NP(K)
RL=RN(L)
RA=RN(L+1)
RB=RN(L+3)
IF(RN(L+2).EQ.R8)GO TO 77
C THIS STAFF?
IF(RA.NE.4)GO TO 2
C SKIPS HOMED NOTES (IN CHORDS)
CC77 IF(RA.EQ.1)GO TO 10
CC27 IF(RA.LE.4)GO TO 177
77 IF(RA.LT.3)GO TO 10
IF(RA.EQ.4)GO TO 444
IF(RA.EQ.3)GO TO 333
C LOOKS AT NOTES,RESTS,CLEFS,BAR LINES,KSIGS,METERS.
IF(RA.LT.17)GO TO 2
GO TO 10
333 IF(RL.LT.3)GO TO 10
C <3 MEANS NOTHING IN P5
IF(RN(L+5).GT.3)GO TO 2
C NOT A REAL CLEF IF >3
GO TO 10
444 IF(RL.GT.2)GO TO 2
C SHOULD CHECK ON BAR LINES NO MATTER WHICH STAFF
10 N=N+1
R(1,N)=RB
IR(2,N)=L
IF(N.EQ.100)GO TO 28
C ONLY TREATS 100 ITEMS AT A TIME.
2 CONTINUE
IF(N.EQ.0)GO TO 11
CC28 KM=JFAC(L)
C SEE FUNCTION JFAC. RSTFAC PNTR.
28 DO 23 K=1,N
23 IF(RN(IR(2,K)+1).NE.4)GO TO 24
C SKIPS IF ONLY BAR LINES ON THIS STAFF
GO TO 11
24 RSTJ2=RSTFAC(KN+1)*PRCNT
C%%%%%24 RSTJ2=RSTFAC(KN+4)*PRCNT
CALL SORT2(R,N)
C JUMP IF LAST IS A BAR LINE.
K=0
JLDGR=0
JX=0
22 K=K+1
122 L=IR(2,K)
RA=RN(L+1)
RB=0
RX=RN(L+5)
C RX=PARAM 5
RX6=RN(L+6)
RY=1
RW=AMOD(RN(L+4),100.)
IF(RA.GT.1)GO TO 4
RZ=RN(L+7)
IF(LDGR.NE.JLDGR)JLDGR=0
LDGR=0
JK=K
DO 32 JJ=JK+1,N+1
K=JJ
RB=R(1,JJ)-R(1,JJ-1)
IF(RB.GT.0.1)GO TO 320
C PUTS THEM AT EXACT SAME POINT IF CLOSER THAN .1
R(1,JJ)=R(1,JJ-1)
GO TO 32
320 IF(RB.GT.RSP)GO TO 35
32 CONTINUE
C FOUND HOW MANY MEMBERS TO CHORD.
35 RB=0
K=K-1
RQ=0
RD=0
125 IF(AMOD(RN(L+4),200.).GT.60.)RY=.6
DO 37 JJ=JK,K-1
IF(RD.NE.0)GO TO 38
C FINDS ONLY HIGH OR! LOW LED. LINE.
JIR=IR(2,JJ)
RW=AMOD(RN(JIR+4),100.)
IF(RW.GT.12)GO TO 277
IF(RW.GE.2)GO TO 38
277 LDGR=-1
IF(RW.GT.12)LDGR=1
IF(JLDGR.EQ.LDGR)GO TO 36
JLDGR=LDGR
C LDGR IS FOR LEDGER LINES.
GO TO 38
36 RD=1.5
RQ=RD
38 IF(RB.GT.2)GO TO 222
C JUMP IF LARGE SPACE AFTER NOTE IS ALREADY SET UP.
RZZ=RN(JIR+7)
RE=RN(JIR+5)
IF(RB.GE.2)GO TO 477
RC=1.5
IF(RZZ.LT.10)GO TO 378
IF(RZZ.GE.20)RC=3.
C 10=DOT, 20=DOUBLE DOT
GO TO 377
378 IF(RE.GE.20)GO TO 477
IF(AMOD(RZZ,10.).EQ.0)GO TO 477
377 RB=RC+EXTEN(RZZ)
CC IF(RZZ.GE.10)GO TO 377
CC IF(RE.GE.20)GO TO 477
CC IF(AMOD(RZZ,10.).EQ.0)GO TO 477
CC377 RB=1.5+EXTEN(RZZ)
C SPACE FOR DOT OR TAIL(IF STEM UP)
477 IF(ABS(RN(JIR+6)).EQ.10)RB=RB+2
C FOR CHORD TONES ON RIGHT OF STEM UP.
C LOOKS THROUGH ALL NOTES OF A CHORD.
222 IF(AMOD(RE,10.).EQ.0)GO TO 37
C JUMP IF NO ACCIS.
425 RD=2*RY+EXTEN(RE)
IF(RQ.GT.RD)RD=RQ
RQ=RD
C FUNCT. EXTEN=AMOD(X,1.)*10.
37 CONTINUE
IF(RY.NE.1)RB=RB-.5*RJSZ
C MINI NOTES NEED LESS SPACE
250 ACCX=0
RC=0
RW=R(1,JX+1)
DO 132 JJ=JX+1,N
IF(RW.NE.R(1,JJ))GO TO 25
KX=IR(2,JJ)
C GET POINTER
IF(RN(KX+1).NE.1)GO TO 25
C ONLY CHECK ON NOTES (THIS IS FOR CHRD NOTES WITH ACCIS)
RE=ABS(RN(KX+6))
IF(RE.GE.10)RC=-2.6
IF(RE.EQ.20)RC=-RC
CC 2/25/76 IF(ABS(RN(KX+6)).GE.20)RC=2.6
RE=AMOD(RN(KX+5),10.0)
C FIND AN ACCI
IF(RE.EQ.0)GO TO 132
IF(RE.GE.1)RC=RC+2
C FOUND AN ACCI
RC=AMOD(RE,1.0)*10.0+RC
C ADD ANY EXTENSION TO THE LEFT
IF(RC.GT.ACCX)ACCX=RC
RC=0
IF(ACCX.GT.RD)RD=ACCX
132 CONTINUE
25 IF(JX.GT.0)R(2,JX)=R(2,JX)+RD*RSTJ2
GO TO 17
4 IF(RA.NE.2)GO TO 33
C NEXT FOR DOTTED RESTS - IN P6
IF(RN(L).GE.4)RB=RN(L+6)*1.5
C NOW GO BACK TO SEE IF THERE IS A NOTE IN SAME HORIZ. POS.
GO TO 250
33 IF(RA.NE.3)GO TO 29
RB=3
IF(RN(L+4).GT.80)RB=1.5
C CHECK ON SIZE NEEDED FOR CLEFS. >80 = MINICLEF
29 IF(RA.NE.4)GO TO 26
RB=-RJSZ/2
RD=.9
GO TO 25
26 IF(RA.NE.18)GO TO 30
RB=-1
RD=1
IF(RX6.LE.9.AND.RX.LE.9)GO TO 25
CC IF(RX.GT.9)GO TO 31
C CHECKS FOR 2-DIGIT METERS
RD=2
RB=0
CN IF(RX6.GT.9)GO TO 31
CN IF(RX.GT.9)GO TO 31
C CHECKS FOR 2-DIGIT METERS
CN RB=-1
CN RD=1
CN GO TO 25
CN31 RB=2
CN RD=3
GO TO 25
30 IF(RA.NE.17)GO TO 17
RX=ABS(RX)
IF(RX.GE.100)RX=RX-100
C +100 FOR NATURALS AS KEYSIG.
RB=2*(RX-1)-2
CC RB=2*(ABS(RX)-1)-2
RD=2
GO TO 25
C SPACES FOR CORRECT NUM OF ACCIS.
17 RC=(RB+RJSZ)*RSTJ2
C RJSZ=DEFAULT SIZE
CC JX=JX+1
JX=K
R(2,JX)=RC
CC R(1,JX)=R(1,K)
3 IF(K.LT.N)GO TO 22
RA=R(1,1)
RB=R(2,1)
DO 13 KX=2,JX
RE=R(1,KX)
C POS. BEFORE SHIFTING
IF(ABS(RE-RA).GT..5)GO TO 14
IF(R(2,KX).GT.RB)GO TO 16
C SKIPS DOUBLE STOPS AND VERY CLOSE ITEMS
GO TO 13
CC IF(RZZ.LE.RB)GO TO 13
C JUMP WHEN SPACE TO ADD IS SMALLER THAN WHAT'S ALREADY THERE
CC RB=RZZ-RB
14 RD=RA+RB-RE
IF(RD.LE.0)GO TO 16
C THERE'S ENOUGH ROOM
CC RD=RA+RB-RE+RD
ROV=ROV+RD
140 R4=RE+RSPC-.001
R5=1000
C MAYBE MORE? ↑↑↑↑↑
R8=RD
R9=0
C GO EXPAND IT
IF(R(2,KX).EQ.0)GO TO 15
CALL MOVIT
R5=R4
R4=RA+.001+RSPC
R8=R4
R9=R5+RD-.001
C FOR ITEMS ON OTHER LINES.
CALL MOVIT
15 RSPC=RSPC+RD
C RSPC SAVES TOTAL SPACE ADDED
16 RB=R(2,KX)
13 RA=RE
11 CONTINUE
110 IF(ROV.LE.RRT+.01)RETURN
IF(RJSZ.GT.4)RJSZ=4
PRCNT=(ROV-RZRO)/(RRT-RZRO)
IF(PRCNT.NE.RP)GO TO 19
101 R4=RZRO
R5=ROV
R8=RZRO
R9=RRT-.001
C JUSTIFYING SPACE DIMINISHES EACH TIME AROUND.
CALL MOVIT
END
C THESE MOVE ENDS OF PARTIAL INNER BEAMS.
SUBROUTINE MVBEAM(I)
C L AND JK ARE FOR MOVES TO DIFF. STAFF.
COMMON JK,L,R8,R9,RDIS /XRN/RN(20000)
Y=RN(JK+I)
Z=ABS(Y)
IF(Z.LT.100.)GO TO 1
C NEXT FOR MINIS, DIAMONDS, 'X' NOTES. (LIMIT OF +-99 ON ALTITUDE.)
Y=AMOD(Y,100.)
X=Y+R8
Z=Z-ABS(Y)+ABS(X)
C PUTS ALL INTO POSITIVE
IF(X)Z=-Z
GO TO 2
1 Z=Y+R8
2 RN(L+I)=Z
END
SUBROUTINE NAMEIN(NAME,EXT)
COMMON /ALF/I(10)
ACCEPT 1,I
DO 2 K=2,6
IF(I(K).EQ.' ')GO TO 3
2 IF(I(K).EQ.'.')GO TO 4
3 REREAD 99,NAME
RETURN
4 GO TO(1,5,6,7,8,9),K
1 FORMAT(10A1)
55 FORMAT(2A1,A3)
66 FORMAT(A2,A1,A3)
77 FORMAT(A3,A1,A3)
88 FORMAT(A4,A1,A3)
99 FORMAT(A5,A1,A3)
5 REREAD 55,NAME,K,EXT
RETURN
6 REREAD 66,NAME,K,EXT
RETURN
7 REREAD 77,NAME,K,EXT
RETURN
8 REREAD 88,NAME,K,EXT
RETURN
9 REREAD 99,NAME,K,EXT
END